En este documento se presentarán las técnicas de agrupación jerárquica y k-medias, una comparación entre ambas aplicadas el mismo conjunto de datos y se avaluará los pros y contras de cada una.
Paquetes a utilizar:
# install.packages("devtools")
# devtools::install_github("thomasp85/patchwork")
library(tidyverse)
library(dendextend)
library(factoextra)
library(patchwork)Para esto primero definiremos un conjunto de datos:
datos <- multishapes[,1:2]Tenemos en nuestra tabla dos variables numérica “x”, “y”.
head(datos)## x y
## 1 -0.8037393 -0.8530526
## 2 0.8528507 0.3676184
## 3 0.9271795 -0.2749024
## 4 -0.7526261 -0.5115652
## 5 0.7068462 0.8106792
## 6 1.0346985 0.3946550
Utilizando el paquete ggplot2 podemos visualizar como se distribuyen nuestros datos.
ggplot(data = datos, mapping = aes(x = x, y = y)) +
geom_point() +
labs(title = "Tabla de datos Original",
subtitle = expression(paste("Datos generados para ilustrar las ", bold("técnicas") ," de cluster jerárquico y k-medias"))) +
theme_minimal()El método de agrupación jerárquica a partir de una matriz de distancias determina la unión de individuos con otros individuos o grupos que en conjunto forman la agrupación “óptima” de los individuos, al trabajar con distancias un factor importante a tomar en cuenta es la escala de las variables, por lo que para evitar que esta pueda afectar los resultados antes de aplicar esta técnica realizaremos una transformación a los datos, en esta los valores de las variables se centraran y escalan, podemos definir este proceso como:
Si A¯ es la media de los valores de la variable A y σA es la desviación estándar el valor original v de A se normaliza en v′ utilizando:
datos.escalados <- scale(datos)library(factoextra)
matriz.distancias <- dist(datos.escalados)2.1 Gráfico de la matriz de distancias:
g <- fviz_dist(matriz.distancias,
gradient = list(low = "#00AFBB",
mid = "white",
high = "#FC4E07"),
order = F)
g + labs(title = "Matriz distancias",
subtitle = "En esta se pueden observar que existe un grupo de individuos cuya distancia es muy corta
\n
mientras que para los demás puntos la distancia entre si es bastante alta.",
fill = "Distancia") + theme(legend.position = "bottom",
axis.text.x = element_blank(),
axis.text.y = element_blank())gEl dendograma es una representación gráfica de la formación de los clusters:
clust <- hclust(matriz.distancias)
dendograma <- clust %>% as.dendrogram %>%
set("branches_k_color", k = 5) %>%
plot(main = "Dendograma")grupos <- cutree(clust, k = 5)
datos$cj <- as.factor(grupos)head(datos)## x y cj
## 1 -0.8037393 -0.8530526 1
## 2 0.8528507 0.3676184 2
## 3 0.9271795 -0.2749024 2
## 4 -0.7526261 -0.5115652 1
## 5 0.7068462 0.8106792 3
## 6 1.0346985 0.3946550 2
ggplot(data = datos, mapping = aes(x = x, y = y, color = as.factor(cj)) )+
geom_point() +
labs(title = "Resultado de la Clasificación Jerárquica") +
theme_minimal() +
scale_color_brewer(palette = "Set1") +
theme(plot.title = element_text(face = "bold"))A diferencia del agrupamiento jerárquico en el que el proceso se realiza tomando como base a una matriz de distancias de todos los individuos contra todos los individuos, el método k-medias determina de forma aleatoria centroides para los grupos y a base de iteraciones en las que se calcula la distancia de los individuos a estos centroides modifica la ubicación de dichos centroides y por lo tanto el cluster al que pertenecen los individuos.
Es importante tener esto claro ya que nos ayuda a entender que el resultado del agrupamiento depende directamente de la cantidad de iteraciones que realiza el proceso, veamos a continuación un ejemplo del como evoluciona la formación de los clusters al aumentar el número de iteraciones.
datos <- multishapes[,1:2]
resultado1 <- kmeans(x = datos, centers = 7, iter.max = 5)
resultado2 <- kmeans(x = datos, centers = 7, iter.max = 10)
resultado3 <- kmeans(x = datos, centers = 7, iter.max = 20)
resultado4 <- kmeans(x = datos, centers = 7, iter.max = 50)
resultado5 <- kmeans(x = datos, centers = 7, iter.max = 100)
resultado6 <- kmeans(x = datos, centers = 7, iter.max = 500)g1 <- ggplot(data = datos, mapping = aes(x = x, y = y, color = as.factor(resultado1$cluster)) )+
geom_point() +
labs(title = "iter.max = 5") +
theme_minimal() +
scale_color_brewer(palette = "Set1") +
theme(plot.title = element_text(face = "bold")) +
theme(legend.position = "none")
g2 <- ggplot(data = datos, mapping = aes(x = x, y = y, color = as.factor(resultado2$cluster)) )+
geom_point() +
labs(title = "iter.max = 10") +
theme_minimal() +
scale_color_brewer(palette = "Set1") +
theme(plot.title = element_text(face = "bold")) +
theme(legend.position = "none")
g3 <- ggplot(data = datos, mapping = aes(x = x, y = y, color = as.factor(resultado3$cluster)) )+
geom_point() +
labs(title = "iter.max = 20") +
theme_minimal() +
scale_color_brewer(palette = "Set1") +
theme(plot.title = element_text(face = "bold")) +
theme(legend.position = "none")
g4 <- ggplot(data = datos, mapping = aes(x = x, y = y, color = as.factor(resultado4$cluster)) )+
geom_point() +
labs(title = "iter.max = 50") +
theme_minimal() +
scale_color_brewer(palette = "Set1") +
theme(plot.title = element_text(face = "bold")) +
theme(legend.position = "none")
g5 <- ggplot(data = datos, mapping = aes(x = x, y = y, color = as.factor(resultado5$cluster)) )+
geom_point() +
labs(title = "iter.max = 100") +
theme_minimal() +
scale_color_brewer(palette = "Set1") +
theme(plot.title = element_text(face = "bold")) +
theme(legend.position = "none")
g6 <- ggplot(data = datos, mapping = aes(x = x, y = y, color = as.factor(resultado6$cluster)) )+
geom_point() +
labs(title = "iter.max = 500") +
theme_minimal() +
scale_color_brewer(palette = "Set1") +
theme(plot.title = element_text(face = "bold")) +
theme(legend.position = "none")
g1 + g2 + g3 + g4 + g5 + g6 + plot_layout(ncol = 2, tag_level = "keep")set.seed(123)
grupos <- fpc::dbscan(datos.escalados, eps = 0.2, MinPts =4)
g <- fviz_cluster(grupos, data = datos.escalados, stand =F,
ellipse = F, show.clust.cent = F,
geom = "point",shape = 19, palette = "Set1",
ggtheme = theme_minimal())
g + labs(title = "Agrupamiento basado en densidad") +
theme(legend.position = "bottom")